home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / games / kids / fouryrs.zoo / color.lst next >
File List  |  1993-03-07  |  5KB  |  226 lines
  1. ' color.gfa
  2. ' Programmed by Seymour Shlien in GFA Basic 3.5
  3. ' 624 Courtenay Avenue
  4. ' Ottawa, Ontario
  5. ' Canada, K2A 3B5
  6. ' Feb 21 1993
  7. DIM deskcolors%(15)
  8. DIM xbs_files$(20)
  9. rez%=XBIOS(4)
  10. IF rez%<>0
  11.   ALERT 3," Please switch   to | low  resolution! ",1,"Oops",b%
  12.   STOP
  13. ENDIF
  14. number_of_xbs_files%=0
  15. @read_put
  16. @read_sound
  17. @set_standard_colors
  18. @dosound
  19. @instructions
  20. @get_deskcolors
  21. file_num%=1
  22. d__load_degas_pi1("color"+STR$(file_num%)+".pi1")
  23. IF found%=0
  24.   @box_pattern
  25. ENDIF
  26. @color_bar
  27. fillpattern%=8
  28. GRAPHMODE 2
  29. REPEAT
  30.   IF MOUSEK=1
  31.     IF MOUSEY>20
  32.       IF POINT(MOUSEX,MOUSEY)<>1
  33.         FILL MOUSEX,MOUSEY
  34.         PAUSE 14
  35.       ENDIF
  36.     ELSE IF MOUSEX<180
  37.       IF MOUSEX<40
  38.         INC fillpattern%
  39.         IF fillpattern%>24
  40.           fillpattern%=1
  41.         ENDIF
  42.         DEFFILL 0,1
  43.         PBOX 1,1,39,16
  44.         DEFFILL col%,2,fillpattern%
  45.         FILL MOUSEX,MOUSEY
  46.         PAUSE 15
  47.       ELSE
  48.         col%=MOUSEX/20
  49.         IF MOUSEY>8
  50.           col%=col%+7
  51.         ENDIF
  52.         DEFFILL 0,1
  53.         PBOX 1,1,39,16
  54.         DEFFILL col%,2,fillpattern%
  55.         FILL 10,10
  56.         PAUSE 15
  57.       ENDIF
  58.     ELSE IF MOUSEX<230
  59.       SPUT s$
  60.       @color_bar
  61.       PAUSE 30
  62.     ELSE IF MOUSEX<270
  63.       INC file_num%
  64.       IF found%=0
  65.         file_num%=1
  66.       ENDIF
  67.       @dosound
  68.       d__load_degas_pi1("color"+STR$(file_num%)+".pi1")
  69.       IF found%=0
  70.         @box_pattern
  71.       ENDIF
  72.       fillpattern%=8
  73.       @color_bar
  74.     ENDIF
  75.   ENDIF
  76. UNTIL ((MOUSEK=1) AND (MOUSEX>270) AND (MOUSEY<20))
  77. @restore_deskcolors
  78. > PROCEDURE read_put
  79.   ' the house
  80.   IF EXIST("color.put")
  81.     OPEN "i",#1,"color.put"
  82.     house$=INPUT$(CVI(INPUT$(2,#1)),#1)
  83.     CLOSE #1
  84.   ELSE
  85.     PRINT "color.put was not found."
  86.     PAUSE 100
  87.   ENDIF
  88. RETURN
  89. > PROCEDURE d__load_degas_pi1(file$)
  90.   '
  91.   LOCAL loop%
  92.   IF EXIST(file$)
  93.     OPEN "i",#1,file$
  94.     s$=INPUT$(2,#1)
  95.     m__current_colors$=INPUT$(32,#1)
  96.     FOR loop%=1 TO 15
  97.       SETCOLOR loop%,CVI(MID$(m__current_colors$,loop%*2+1,2))
  98.     NEXT loop%
  99.     s$=INPUT$(32000,#1)
  100.     CLOSE #1
  101.     SPUT s$
  102.     found%=1
  103.   ELSE
  104.     CLS
  105.     LOCATE 1,15
  106.     PRINT file$+" was not found."
  107.     found%=0
  108.     PAUSE 50
  109.   ENDIF
  110. RETURN
  111. > PROCEDURE color_bar
  112.   COLOR 1
  113.   FOR i=2 TO 8
  114.     DEFFILL i,1
  115.     PBOX i*20,0,(i+1)*20,8
  116.     BOX i*20,0,(i+1)*20,8
  117.     DEFFILL i+7
  118.     PBOX i*20,9,(i+1)*20,16
  119.     BOX i*20,9,(i+1)*20,17
  120.   NEXT i
  121.   DEFTEXT 1
  122.   LINE 0,0,319,0
  123.   TEXT 184,14,"CLEAR"
  124.   LINE 180,0,180,17
  125.   TEXT 230,14,"NEXT"
  126.   LINE 228,0,228,17
  127.   TEXT 270,14,"QUIT"
  128.   LINE 268,0,268,17
  129.   LINE 319,0,319,17
  130.   DEFMOUSE 0
  131.   LINE 0,17,319,17
  132.   BOX 0,0,39,17
  133. RETURN
  134. > PROCEDURE get_deskcolors
  135.   LOCAL i%
  136.   FOR i%=0 TO 15
  137.     deskcolors%(i%)=XBIOS(7,i%,-1)
  138.   NEXT i%
  139. RETURN
  140. > PROCEDURE restore_deskcolors
  141.   LOCAL i%
  142.   FOR i%=0 TO 15
  143.     SETCOLOR i%,deskcolors%(i%)
  144.   NEXT i%
  145. RETURN
  146. > PROCEDURE read_sound
  147.   LOCAL a%
  148.   IF EXIST("color.xbs")
  149.     OPEN "i",#1,"color.xbs"
  150.     a%=LOF(#1)
  151.     DIM music_data&(a%/2)
  152.     BLOAD "color.xbs",VARPTR(music_data&(0))
  153.     CLOSE #1
  154.     number_of_xbs_files%=1
  155.   ELSE
  156.     LOCATE 1,18
  157.     PRINT "color.xbs was not found"
  158.     number_of_xbs_files%=0
  159.   ENDIF
  160. RETURN
  161. > PROCEDURE dosound
  162.   LOCAL i%
  163.   IF number_of_xbs_files%>0
  164.     '  SPOKE &H484,PEEK(&H484) AND NOT 1
  165.     addr%=V:music_data&(0)
  166.     ~XBIOS(32,L:addr%)
  167.   ENDIF
  168. RETURN
  169. > PROCEDURE box_pattern
  170.   LOCAL i%,ix1%,ix2%,iy1%,iy2%
  171.   CLS
  172.   COLOR 1
  173.   FOR i%=0 TO 8
  174.     x=COSQ(i%*40)+SINQ(i%*40)
  175.     y=-SINQ(i%*40)+COSQ(i%*40)
  176.     ix%=140+40*x
  177.     iy%=80+40*y
  178.     BOX ix%,iy%,ix%+50,iy%+50
  179.   NEXT i%
  180.   SGET s$
  181.   PAUSE 50
  182. RETURN
  183. > PROCEDURE instructions
  184.   CLS
  185.   PRINT "       COLOR"
  186.   PRINT
  187.   PRINT "Using the mouse pointer, click on"
  188.   PRINT "any color in the pallette on top"
  189.   PRINT "of the screen and then click in"
  190.   PRINT "any area in the outlined picture."
  191.   PRINT "Once your picture is colored, add"
  192.   PRINT "textures by clicking in the white box"
  193.   PRINT "in the top left until the desired"
  194.   PRINT "texture is found."
  195.   PRINT
  196.   PRINT "Seymour Shlien 17-January-93"
  197.   PRINT
  198.   PRINT "Click mouse button to continue."
  199.   PUT 200,150,house$
  200.   REPEAT
  201.   UNTIL MOUSEK<>0
  202. RETURN
  203. > PROCEDURE set_standard_colors
  204.   LOCAL i%,j%
  205.   FOR i%=0 TO 15
  206.     READ j%
  207.     SETCOLOR i%,j%
  208.   NEXT i%
  209.   DATA 4095
  210.   DATA 3840
  211.   DATA 240
  212.   DATA 4080
  213.   DATA 15
  214.   DATA 3855
  215.   DATA 255
  216.   DATA 1365
  217.   DATA 819
  218.   DATA 3891
  219.   DATA 1011
  220.   DATA 4083
  221.   DATA 831
  222.   DATA 3901
  223.   DATA 1023
  224.   DATA 0
  225. RETURN
  226.